home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Programming / Programming Languages / UCB Logo 3.0 ƒ / sources / standard source / logodata.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-08-14  |  12.5 KB  |  623 lines  |  [TEXT/ttxt]
  1. /*
  2.  *      logodata.c      logo data management module             dvb
  3.  *
  4.  *    Copyright (C) 1993 by the Regents of the University of California
  5.  *
  6.  *      This program is free software; you can redistribute it and/or modify
  7.  *      it under the terms of the GNU General Public License as published by
  8.  *      the Free Software Foundation; either version 2 of the License, or
  9.  *      (at your option) any later version.
  10.  *  
  11.  *      This program is distributed in the hope that it will be useful,
  12.  *      but WITHOUT ANY WARRANTY; without even the implied warranty of
  13.  *      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14.  *      GNU General Public License for more details.
  15.  *  
  16.  *      You should have received a copy of the GNU General Public License
  17.  *      along with this program; if not, write to the Free Software
  18.  *      Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  *
  20.  */
  21.  
  22. #include "logo.h"
  23. #include "globals.h"
  24. #include <stdlib.h>
  25. #include <stdarg.h>
  26. #include <string.h>
  27. #ifdef ibm
  28. #ifndef __ZTC__
  29. #include <alloc.h>
  30. #endif
  31. #endif
  32.  
  33. char special_chars[] = " \t\n()[]+-*/=<>\"\\~:;|?";
  34.  
  35. #ifdef ecma
  36.  
  37. #include <iso_ctype.h>
  38.  
  39. #define upper_p(ch)    (isupper((ch) & 0377))
  40. #define lower_p(ch)    (islower((ch) & 0377))
  41.  
  42. char ecma_array[128];
  43.  
  44. int ecma_size = sizeof(special_chars);
  45.  
  46. char ecma_set(int ch)
  47. {
  48.     ch &= 0377;
  49.     if (ch >= 0200) return(ch);
  50.     return(ecma_array[ch]);
  51. }
  52.  
  53. char ecma_clear(int ch)
  54. {
  55.     ch &= 0377;
  56.     if (ch < 0200 || ch >= 0200+sizeof(special_chars)) return(ch);
  57.     return(special_chars[ch - 0200]);
  58. }
  59.  
  60. int ecma_get(int ch)
  61. {
  62.     ch &= 0377;
  63.     return (ch >= 0200 && ch < 0200+sizeof(special_chars));
  64. }
  65.  
  66. #else
  67.  
  68. #define upper_p(c)     (c >= 'A' && c <= 'Z')
  69. #define lower_p(c)     (c >= 'a' && c <= 'z')
  70.  
  71. #endif
  72.  
  73. char *strnzcpy(char *s1, char *s2, int n)
  74. {
  75.     strncpy(s1, s2, n);
  76.     s1[n] = '\0';
  77.     return(s1);
  78. }
  79.  
  80. char *word_strnzcpy(char *s1, NODE *kludge, int n)  /* KLUDGE! */
  81. {
  82.     char *temp = s1;
  83.  
  84.     while (kludge != NIL) {
  85.     strncpy(s1, getstrptr(car(kludge)), getstrlen(car(kludge)));
  86.     s1 += getstrlen(car(kludge));
  87.     kludge = cdr(kludge);
  88.     }
  89.     temp[n] = '\0';
  90.     return(temp);
  91. }
  92.  
  93. char *noparity_strnzcpy(char *s1, char *s2, int n)
  94. {
  95.     int i;
  96.  
  97.     for (i = 0; i < n; i++)
  98.     s1[i] = clearparity(s2[i]);
  99.     s1[n] = '\0';
  100.     return(s1);
  101. }
  102.  
  103. char *mend_strnzcpy(char *s1, char *s2, int n)
  104. {
  105.     int i, vbar = 0;
  106.  
  107.     for (i = 0; i < n; ) {
  108.     while (*s2 == '|') {
  109.         vbar = !vbar;
  110.         s2++;
  111.     }
  112.     if (vbar) {
  113.         if (strchr(special_chars,(int)*s2))
  114.         s1[i++] = setparity(*s2++);
  115.         else
  116.         s1[i++] = *s2++;
  117.     } else {
  118.         while (*s2 == ';' || (*s2 == '~' && *(s2 + 1) == '\n')) {
  119.         while (*s2 == '~' && *(s2 + 1) == '\n') s2 += 2;
  120.         if (*s2 == ';')
  121.             do {
  122.             s2++;
  123.             } while (*s2 != '\0' && *s2 != '~' && *(s2 + 1) != '\n');
  124.         }
  125.         if (*s2 != '|') s1[i++] = *s2++;
  126.     }
  127.     }
  128.     s1[n] = '\0';
  129.     return(s1);
  130. }
  131.  
  132. char *mend_nosemi(char *s1, char *s2, int n)
  133. {
  134.     int i, vbar = 0;
  135.  
  136.     for (i = 0; i < n; ) {
  137.     while (*s2 == '|') {
  138.         vbar = !vbar;
  139.         s2++;
  140.     }
  141.     if (vbar) {
  142.         if (strchr(special_chars,(int)*s2))
  143.         s1[i++] = setparity(*s2++);
  144.         else
  145.         s1[i++] = *s2++;
  146.     } else {
  147.         while ((*s2 == '~' && *(s2 + 1) == '\n')) {
  148.         while (*s2 == '~' && *(s2 + 1) == '\n') s2 += 2;
  149.         }
  150.         if (*s2 != '|') s1[i++] = *s2++;
  151.     }
  152.     }
  153.     s1[n] = '\0';
  154.     return(s1);
  155. }
  156.  
  157. char *quote_strnzcpy(char *s1, char *s2, int n)
  158. {
  159.     s1[0] = '"';
  160.     strncpy(s1 + 1, s2, n - 1);
  161.     s1[n] = '\0';
  162.     return(s1);
  163. }
  164.  
  165. char *colon_strnzcpy(char *s1, char *s2, int n)
  166. {
  167.     s1[0] = ':';
  168.     strncpy(s1 + 1, s2, n - 1);
  169.     s1[n] = '\0';
  170.     return(s1);
  171. }
  172.  
  173. #define uncapital(c)    (c - 'A' + 'a')
  174.  
  175. char *low_strnzcpy(char *s1, char *s2, int n)
  176. {
  177.     char *temp = s1;
  178.     int i;
  179.  
  180.     for (i = 0; i < n; i++) {
  181.     if (upper_p(*s2))
  182.         *s1++ = uncapital(*s2++);
  183.     else
  184.         *s1++ = *s2++;
  185.     }
  186.     *s1 = '\0';
  187.     return(temp);
  188. }
  189.  
  190. #define capital(c)    (c - 'a' + 'A')
  191.  
  192. char *cap_strnzcpy(char *s1, char *s2, int n)
  193. {
  194.     char *temp = s1;
  195.     int i;
  196.  
  197.     for (i = 0; i < n; i++) {
  198.     if (lower_p(*s2))
  199.         *s1++ = capital(*s2++);
  200.     else
  201.         *s1++ = *s2++;
  202.     }
  203.     *s1 = '\0';
  204.     return(temp);
  205. }
  206.  
  207. char *noparitylow_strnzcpy(char *s1, char *s2, int n)
  208. {
  209.     int i;
  210.     char c, *temp = s1;
  211.  
  212.     for (i = 0; i < n; i++) {
  213.     c = clearparity(*s2++);
  214.     if (upper_p(c))
  215.         *s1++ = uncapital(c);
  216.     else
  217.         *s1++ = c;
  218.     }
  219.     *s1 = '\0';
  220.     return(temp);
  221. }
  222.  
  223. int low_strncmp(char *s1, char *s2, int n)
  224. {
  225.     int i;
  226.  
  227.     for (i = 0; i < n; i++) {
  228.     if (*s1 != *s2) {
  229.         if (upper_p(*s2)) {
  230.         if (upper_p(*s1)) {
  231.             if (uncapital(*s1) != uncapital(*s2))
  232.             return(uncapital(*s1) - uncapital(*s2));
  233.         } else {
  234.             if (*s1 != uncapital(*s2))
  235.             return(*s1 - uncapital(*s2));
  236.         }
  237.         } else if (upper_p(*s1)) {
  238.         if (uncapital(*s1) != *s2)
  239.             return(uncapital(*s1) - *s2);
  240.         } else return(*s1 - *s2);
  241.     }
  242.     s1++, s2++;
  243.     }
  244.     return(0);
  245. }
  246.  
  247. int noparity_strncmp(char *s1, char *s2, int n)
  248. {
  249.     int i;
  250.  
  251.     for (i = 0; i < n; i++) {
  252.     if (clearparity(*s1) != clearparity(*s2))
  253.         return(clearparity(*s1) - clearparity(*s2));
  254.     s1++, s2++;
  255.     }
  256.     return(0);
  257. }
  258.  
  259. int noparitylow_strncmp(char *s1, char *s2, int n)
  260. {
  261.     int i;
  262.     char c1, c2;
  263.  
  264.     for (i = 0; i < n; i++) {
  265.     c1 = clearparity(*s1);
  266.     c2 = clearparity(*s2);
  267.     if (c1 != c2) {
  268.         if (upper_p(c2)) {
  269.         if (upper_p(c1)) {
  270.             if (uncapital(c1) != uncapital(c2))
  271.             return(uncapital(c1) - uncapital(c2));
  272.         } else {
  273.             if (c1 != uncapital(c2))
  274.             return(c1 - uncapital(c2));
  275.         }
  276.         } else if (upper_p(c1)) {
  277.         if (uncapital(c1) != c2)
  278.             return(uncapital(c1) - c2);
  279.         } else return(c1 - c2);
  280.     }
  281.     s1++, s2++;
  282.     }
  283.     return(0);
  284. }
  285.  
  286. NODE *make_strnode(char *strptr, char *strhead, int len,
  287.            NODETYPES typ, char *(*copy_routine)())
  288. {
  289.     NODE *strnode;
  290.  
  291.     if (len == 0 && Null_Word != NIL) return(Null_Word);
  292.     strnode = newnode(typ);
  293.     if (strhead == NULL) {
  294.     strhead = (char *) malloc((size_t)len + 2);
  295.     (*copy_routine) (strhead + 1, strptr, len);
  296.     strptr = strhead + 1;
  297.     setstrrefcnt(strhead, 0);
  298.     }
  299.     setstrlen(strnode, len);
  300.     setstrptr(strnode, strptr);
  301.     setstrhead(strnode, strhead);
  302.     incstrrefcnt(strhead);
  303.     return(strnode);
  304. }
  305.  
  306. void make_runparse(NODE *ndi)
  307. {
  308.     NODE *rp_list;
  309.  
  310.     rp_list = runparse(ndi);
  311.     ref(rp_list);    /* I don't understand why this is necessary. */
  312.     setobject(ndi, rp_list);
  313.     settype(ndi, RUN_PARSE);
  314. }
  315.  
  316. NODE *make_quote(NODE *qnd)
  317. {
  318.     NODE *nd;
  319.  
  320.     nd = cons(qnd, NIL);
  321.     settype(nd, QUOTE);
  322.     return(nd);
  323. }
  324.  
  325. NODE *maybe_quote(NODE *nd)
  326. {
  327.     if (nd == UNBOUND || aggregate(nd) || numberp(nd)) return(nd);
  328.     return(make_quote(nd));
  329. }
  330.  
  331. NODE *make_caseobj(NODE *cstrnd, NODE *obj)
  332. {
  333.     NODE *nd;
  334.  
  335.     nd = cons(cstrnd, obj);
  336.     settype(nd, CASEOBJ);
  337.     return(nd);
  338. }
  339.  
  340. NODE *make_colon(NODE *cnd)
  341. {
  342.     NODE *nd;
  343.  
  344.     nd = cons(cnd, NIL);
  345.     settype(nd, COLON);
  346.     return(nd);
  347. }
  348.  
  349. NODE *make_intnode(FIXNUM i)
  350. {
  351.     NODE *nd = newnode(INT);
  352.  
  353.     setint(nd, i);
  354.     return(nd);
  355. }
  356.  
  357. NODE *make_floatnode(FLONUM f)
  358. {
  359.     NODE *nd = newnode(FLOAT);
  360.  
  361.     setfloat(nd, f);
  362.     return(nd);
  363. }
  364.  
  365. NODE *cnv_node_to_numnode(NODE *ndi)
  366. {
  367.     NODE *val;
  368.     int dr;
  369.     char s2[MAX_NUMBER], *s = s2;
  370.  
  371.     if (is_number(ndi))
  372.     return(ndi);
  373.     ndi = cnv_node_to_strnode(ndi);
  374.     if (ndi == UNBOUND) return(UNBOUND);
  375.     if (((getstrlen(ndi)) < MAX_NUMBER) && (dr = numberp(ndi))) {
  376.     if (backslashed(ndi))
  377.         noparity_strnzcpy(s, getstrptr(ndi), getstrlen(ndi));
  378.     else
  379.         strnzcpy(s, getstrptr(ndi), getstrlen(ndi));
  380.     if (*s == '+') ++s;
  381.     if (s2[getstrlen(ndi)-1] == '.') s2[getstrlen(ndi)-1] = 0;
  382.     if (dr - 1 || getstrlen(ndi) > 9) {
  383.         val = newnode(FLOAT);
  384.         setfloat(val, atof(s));
  385.     } else {
  386.         val = newnode(INT);
  387.         setint(val, atol(s));
  388.     }
  389.     gcref(ndi);
  390.     return(val);
  391.     } else {
  392.     gcref(ndi);
  393.     return(UNBOUND);
  394.     }
  395. }
  396.  
  397. NODE *cnv_node_to_strnode(NODE *nd)
  398. {
  399.     char s[MAX_NUMBER];
  400.  
  401.     if (nd == UNBOUND || aggregate(nd)) {
  402.     return(UNBOUND);
  403.     }
  404.     switch(nodetype(nd)) {
  405.     case STRING:
  406.     case BACKSLASH_STRING:
  407.     case VBAR_STRING:
  408.         return(nd);
  409.     case CASEOBJ:
  410.         return strnode__caseobj(nd);
  411.     case QUOTE:
  412.         nd = valref(cnv_node_to_strnode(node__quote(nd)));
  413.         nd = reref(nd, make_strnode(getstrptr(nd),
  414.                     (char *)NULL, getstrlen(nd) + 1,
  415.                     nodetype(nd), quote_strnzcpy));
  416.         unref(nd);
  417.         return(nd);
  418.     case COLON:
  419.         nd = valref(cnv_node_to_strnode(node__colon(nd)));
  420.         nd = reref(nd, make_strnode(getstrptr(nd),
  421.                     (char *)NULL, getstrlen(nd) + 1,
  422.                     nodetype(nd), colon_strnzcpy));
  423.         unref(nd);
  424.         return(nd);
  425.     case INT:
  426.         sprintf(s, "%ld", getint(nd));
  427.         return(make_strnode(s, (char *)NULL, (int)strlen(s),
  428.                 STRING, strnzcpy));
  429.     case FLOAT:
  430.         sprintf(s, "%0.15g", getfloat(nd));
  431.         return(make_strnode(s, (char *)NULL, (int)strlen(s),
  432.                 STRING, strnzcpy));
  433.     }
  434.     /*NOTREACHED*/
  435. }
  436.  
  437. NODE *make_static_strnode(char *strptr)
  438. {
  439.     NODE *strnode = newnode(STRING);
  440.  
  441.     setstrptr(strnode, strptr);
  442.     setstrhead(strnode, NULL);
  443.     setstrlen(strnode, (int)strlen(strptr));
  444.     return(strnode);
  445. }
  446.  
  447. NODE *cons_list(int dummy, ...)
  448. {
  449.     va_list ap;
  450.     NODE *nptr, *outline = NIL, *lastnode, *val;
  451.  
  452.      va_start(ap, dummy);
  453.      while ( (nptr = va_arg(ap, NODE *)) != END_OF_LIST) {
  454.     val = cons(nptr, NIL);
  455.     if (outline == NIL) {
  456.         outline = val;
  457.         lastnode = outline;
  458.     } else {
  459.         setcdr(lastnode, val);
  460.         lastnode = val;
  461.     }
  462.      }
  463.     va_end(ap);
  464.     return(outline);
  465. }
  466.  
  467. NODE *make_array(int len)
  468. {
  469.     NODE *node;
  470.     NODE **data;
  471.  
  472.     node = newnode(ARRAY);
  473.     setarrorg(node,1);
  474.     setarrdim(node,len);
  475.     data = (NODE **)malloc((size_t)len * sizeof(NODE *));
  476.     setarrptr(node,data);
  477.     while (--len >= 0) *data++ = NIL;
  478.     return(node);
  479. }
  480.  
  481. NODE *llowercase(NODE *args)
  482. {
  483.     NODE *arg;
  484.  
  485.     arg = string_arg(args);
  486.     if (NOT_THROWING) {
  487.     return make_strnode(getstrptr(arg), (char *)NULL,
  488.                 getstrlen(arg), nodetype(arg), low_strnzcpy);
  489.     }
  490.     return UNBOUND;
  491. }
  492.  
  493. NODE *luppercase(NODE *args)
  494. {
  495.     NODE *arg;
  496.  
  497.     arg = string_arg(args);
  498.     if (NOT_THROWING) {
  499.     return make_strnode(getstrptr(arg), (char *)NULL,
  500.                 getstrlen(arg), nodetype(arg), cap_strnzcpy);
  501.     }
  502.     return UNBOUND;
  503. }
  504.  
  505. /* property list stuff */
  506.  
  507. NODE *getprop(NODE *plist, NODE *name, BOOLEAN before)
  508. {
  509.     NODE *prev = NIL;
  510.     BOOLEAN caseig = FALSE;
  511.  
  512.     if (compare_node(valnode__caseobj(Caseignoredp), True, TRUE) == 0)
  513.     caseig = TRUE;
  514.     while (plist != NIL) {
  515.     if (compare_node(name,car(plist),caseig) == 0) {
  516.         return(before ? prev : plist);
  517.     }
  518.     prev = plist;
  519.     plist = cddr(plist);
  520.     }
  521.     return(NIL);
  522. }
  523.  
  524. NODE *lgprop(NODE *args)
  525. {
  526.     NODE *plname, *pname, *plist, *val = NIL;
  527.  
  528.     plname = string_arg(args);
  529.     pname = string_arg(cdr(args));
  530.     if (NOT_THROWING) {
  531.     plname = intern(plname);
  532.     plist = plist__caseobj(plname);
  533.     if (plist != NIL)
  534.         val = getprop(plist, pname, FALSE);
  535.     if (val != NIL)
  536.         return cadr(val);
  537.     }
  538.     return NIL;
  539. }
  540.  
  541. NODE *lpprop(NODE *args)
  542. {
  543.     NODE *plname, *pname, *newval, *plist, *val = NIL;
  544.  
  545.     plname = string_arg(args);
  546.     pname = string_arg(cdr(args));
  547.     newval = car(cddr(args));
  548.     if (NOT_THROWING) {
  549.     plname = intern(plname);
  550.     if (flag__caseobj(plname, PLIST_TRACED)) {
  551.         ndprintf(writestream, "Pprop %s %s %s", maybe_quote(plname),
  552.              maybe_quote(pname), maybe_quote(newval));
  553.         if (ufun != NIL)
  554.         ndprintf(writestream, " in %s\n%s", ufun, this_line);
  555.         new_line(writestream);
  556.     }
  557.     plist = plist__caseobj(plname);
  558.     if (plist != NIL)
  559.         val = getprop(plist, pname, FALSE);
  560.     if (val != NIL)
  561.         setcar(cdr(val), newval);
  562.     else
  563.         setplist__caseobj(plname, cons(pname, cons(newval, plist)));
  564.     }
  565.     return(UNBOUND);
  566. }
  567.  
  568. NODE *lremprop(NODE *args)
  569. {
  570.     NODE *plname, *pname, *plist, *val = NIL;
  571.     BOOLEAN caseig = FALSE;
  572.  
  573.     if (compare_node(valnode__caseobj(Caseignoredp), True, TRUE) == 0)
  574.     caseig = TRUE;
  575.     plname = string_arg(args);
  576.     pname = string_arg(cdr(args));
  577.     if (NOT_THROWING) {
  578.     plname = intern(plname);
  579.     plist = plist__caseobj(plname);
  580.     if (plist != NIL) {
  581.         if (compare_node(car(plist), pname, caseig) == 0)
  582.         setplist__caseobj(plname, cddr(plist));
  583.         else {
  584.         val = getprop(plist, pname, TRUE);
  585.         if (val != NIL)
  586.             setcdr(cdr(val), cddr(cddr(val)));
  587.         }
  588.     }
  589.     }
  590.     return(UNBOUND);
  591. }
  592.  
  593. NODE *copy_list(NODE *arg)
  594. {
  595.     NODE *tnode, *lastnode, *val = NIL;
  596.  
  597.     while (arg != NIL) {
  598.     tnode = cons(car(arg), NIL);
  599.     arg = cdr(arg);
  600.     if (val == NIL) {
  601.         lastnode = val = tnode;
  602.     } else {
  603.         setcdr(lastnode, tnode);
  604.         lastnode = tnode;
  605.     }
  606.     }
  607.     return(val);
  608. }
  609.  
  610. NODE *lplist(NODE *args)
  611. {
  612.     NODE *plname, *plist, *val = NIL;
  613.  
  614.     plname = string_arg(args);
  615.     if (NOT_THROWING) {
  616.     plname = intern(plname);
  617.     plist = plist__caseobj(plname);
  618.     if (plist != NIL)
  619.         val = copy_list(plist);
  620.     }
  621.     return(val);
  622. }
  623.